home *** CD-ROM | disk | FTP | other *** search
/ Merciful 1 / Merciful - Disc 1.iso / software / t / tale / tale.dms / in.adf / tale.s < prev    next >
Encoding:
Text File  |  1990-04-22  |  24.8 KB  |  876 lines
  1. '**   Turbo Audio List Editor
  2. '**   (c) 1990 Dutch Art Editor development
  3. '**   coded by Mitch
  4. '**
  5.  
  6.  
  7. GOTO start
  8.  
  9. breke: 
  10. GOTO einde
  11. RETURN
  12.  
  13. header:
  14. COLOR 3,0 : CLS : PRINT "TALE v1.7" : PRINT
  15. COLOR 2,0 : RETURN
  16.  
  17. getanumber:
  18. x=POS(0) : y=CSRLIN
  19. COLOR 3,0 : a=0 : t=0
  20. getnumber:
  21. t=t+1 : IF t < 40 THEN getno
  22. t=0 : IF a=0 THEN LOCATE y,x : PRINT "_" : a=1 : GOTO getno
  23. a=0 : LOCATE y,x : PRINT " "
  24. getno:
  25. a$=INKEY$ : IF a$ <"0" OR a$>"9" THEN getnumber
  26. COLOR 2,0 : RETURN
  27.  
  28. wrcom:
  29. l=link(i)
  30. LOCATE 3,1 : PRINT "HEADER: ";header$(i) : PRINT "INFO  : ";index$(l,1)
  31. PRINT "INDEX : 1..15"
  32. FOR y = 6 TO 20 : LOCATE y+1,1 : a$=index$(l,y-4)
  33. PRINT SPACE$(76) : LOCATE y+1,1
  34. PRINT a$ :  NEXT
  35. IF index$(l,17)="" THEN RETURN
  36. GOSUB retern
  37. LOCATE 5,1 : PRINT "INDEX : 16..30"
  38. FOR y = 6 TO 20 : LOCATE y+1,1 :a$=index$(l,y+11)
  39. PRINT SPACE$(76) : LOCATE y+1,1
  40. PRINT a$ : NEXT
  41. RETURN
  42. wrhd:
  43. COLOR 2,0 : PRINT " ";header$(i) : RETURN
  44. wrhdp:
  45. l=link(i):y=y+1
  46. COLOR 2,0 : PRINT header$(i) : PRINT index$(l,1) : RETURN
  47.  
  48. retern:
  49. xt=0
  50. LOCATE 24,1 : COLOR 2,0 : PRINT "PRESS RETURN";
  51. retern3:
  52. a$=INKEY$ : IF a$=CHR$(27) THEN xt=1 : GOTO retern2
  53. IF a$<>CHR$(13) THEN retern3
  54. retern2:
  55. LOCATE 24,1 : COLOR 0,0 : PRINT "PRESS RETURN";
  56. COLOR 2,0 : RETURN
  57.  
  58. wrsn:
  59. FOR i = 1 TO LEN(a$) : COLOR 2,0 : PRINT MID$(a$,i,1);
  60. COLOR 3,0 : PRINT "_"; : LOCATE CSRLIN,POS(0)-1 
  61. FOR j = 1 TO 30 : NEXT : NEXT : PRINT " "; : COLOR 2,0 : RETURN
  62.  
  63. gettext:
  64. x=POS(0) : y=CSRLIN:b$=""
  65. gettextwacht:
  66. t=t+1 : IF t < 20 THEN gettextwacht2
  67. COLOR 3,0
  68. t=0 : IF a=0 THEN LOCATE y,x : PRINT "_" : a=1 : GOTO gettextwacht2
  69. a=0 : LOCATE y,x : PRINT " "
  70. gettextwacht2:
  71. COLOR 2,0
  72. a$=INKEY$ : IF a$=CHR$(13) THEN gettextklaar
  73. IF a$=CHR$(8) AND b$>"" THEN gtxtbs
  74. IF LEN(b$) > 78 THEN gettextwacht
  75. IF a$="" THEN gettextwacht
  76. b=ASC(a$)
  77. IF b > 31 AND b < 123 THEN b$=b$+a$ : LOCATE y,x : PRINT a$:x=x+1
  78. GOTO gettextwacht
  79. gtxtbs:
  80. b$=LEFT$(b$,LEN(b$)-1) : LOCATE y,x : PRINT " " : x=x-1
  81. t=30 : GOTO gettextwacht
  82. gettextklaar:
  83. LOCATE y,x : PRINT " " : RETURN
  84.  
  85.  
  86. start:
  87. WINDOW 1,,(0,0)-(10,10),0,-1
  88. WINDOW 2,,(0,0)-(630,220),16,-1
  89. MENU 1,0,0,""
  90. ON BREAK GOSUB breke : BREAK ON
  91. PALETTE 0,0,0,.3 : PALETTE 1,0,0,.3: PALETTE 2,.1,.1,.9
  92. PALETTE 3,.3,.3,1
  93. startitnotyet:
  94. GOSUB header : GOSUB getcode : IF xt=1 THEN startitnotyet
  95. GOTO startit
  96.  
  97. getcode:
  98. xt=0 : PRINT "Enter accesscode: ";
  99. b$="" : FOR i = 1 TO 4
  100. GOSUB getanumber : LOCATE y,x : PRINT a$;
  101. b$=b$+a$ : NEXT : IF b$="8087" THEN RETURN
  102. xt=1 : RETURN
  103.  
  104. startit:
  105. PALETTE 3,1,1,1 : CLS : COLOR 2,0 : LOCATE 8,33 : PRINT "  T A L E "
  106. LOCATE 10,28 : PRINT "turbo audio list editor"
  107.  
  108.  
  109. LOCATE 20,30 : COLOR 2,0 : PRINT ". . . . . . . . . ."
  110. LOCATE 20,30 : COLOR 3,0
  111. OPEN "TALED" FOR INPUT AS #2
  112. INPUT #2,nu : t=INT(nu/10) : b=t
  113. k=nu+45 : IF k < 150 THEN k=150
  114. DIM index$(k,31),header$(k),link(k),buffer$(30)
  115. FOR i = 1 TO nu
  116. IF i = t THEN PRINT ". "; : t=t+b
  117. LINE INPUT #2,header$(i)
  118. INPUT #2,link(i)
  119. FOR j = 1 TO 31
  120. LINE INPUT #2,index$(i,j)
  121. IF index$(i,j)="@" THEN index$(i,j)="" : GOTO ldd
  122. NEXT j
  123. ldd:
  124. NEXT i
  125. CLOSE #2
  126. CLS : PALETTE 3,.3,.3,1
  127. FOR i = 1 TO 30 : buffer$(i)="THESE MIGHT BE FILLED YOU KNOW!" : NEXT
  128.  
  129. GOSUB header
  130. PRINT
  131. PRINT
  132. PRINT "coded by : Mitch"
  133. PRINT "(c) 1990 Dutch Art Editor Development"
  134. PRINT 
  135. PRINT "Aditional testing : DIGITIX audio data handling crew"
  136. PRINT "Structurizing and editor environment : Mitch"
  137. PRINT
  138. PRINT
  139. PRINT
  140. PRINT
  141. PRINT 
  142. PRINT "All rights reserved"
  143. GOSUB retern
  144.  
  145. keuze:
  146. xt=0
  147. GOSUB header
  148. PRINT:kk=0 : l=0 : b=0
  149. FOR i = 1 TO nu
  150. a$=LEFT$(index$(i,1),4)
  151. IF a$="TAPE" THEN kk=kk+1
  152. IF a$="CD  " THEN l=l+1
  153. IF a$="RECD" THEN b=b+1
  154. NEXT
  155. PRINT "CD's    :";l
  156. PRINT "Tapes   :";kk
  157. PRINT "Records :";b; : LOCATE CSRLIN,30 : PRINT "Total :";l+kk+b:PRINT 
  158. IF l+kk+b <> nu THEN PRINT" Totals error...." : GOTO 8088
  159. PRINT 
  160. PRINT 
  161. PRINT "MENU:  1. Input"
  162. PRINT "       2. Delete"
  163. PRINT "       3. Display"
  164. PRINT "       4. Print"
  165. PRINT "       5. Edit"
  166. PRINT "       6. Save datafile"
  167. PRINT "       7. Rename header + new specifications"
  168. PRINT "       8. Delete all"
  169. PRINT "       9. Special menu"
  170. PRINT : PRINT "Choice : ";
  171. kwacht:
  172. GOSUB getanumber : LOCATE y,x
  173. b=VAL(a$) : IF b = 0 THEN kwacht
  174. ON b GOSUB 1000,2000,3000,4000,6000,5000,sm2,8000,9999
  175. GOTO keuze
  176.  
  177. 5000 GOSUB header : a$="Save requested." : GOSUB wrsn : PRINT
  178. a$="Confirm (c/..) : " : GOSUB wrsn:COLOR 3,0 : PRINT "_" : COLOR 2,0
  179. 5100 a$=INKEY$ : IF a$="c" THEN 5110
  180. IF a$="" THEN 5100
  181. RETURN
  182. 5110 GOSUB svdata : RETURN
  183.  
  184. 3000 GOSUB header :x=3 : y=0
  185. FOR i = 1 TO nu
  186. y=y+1
  187. GOSUB wrhd
  188. IF y = 18 THEN xt=0 : GOSUB 3010 : IF xt=1 THEN RETURN
  189. 3005 NEXT :
  190. IF nu > 17 THEN GOSUB bottom : GOTO 3005
  191. 3006 xt=0 : GOSUB 3010 : IF xt=1 THEN RETURN
  192. GOTO 3006
  193.  
  194. 3010 
  195. LOCATE x-1,1 : PRINT " " : LOCATE x+1,1: PRINT " "
  196. LOCATE 20,1 : PRINT " " : LOCATE 3,1 : PRINT " "
  197. LOCATE x,1 : COLOR 0,3 : PRINT " " : COLOR 2,0
  198. LOCATE 22,1
  199. PRINT "< ";i-18;"  [";nu;"]  ";nu-i;" >            cursor : ";i-20+x
  200. PRINT "Left/Right-Backward/Forward   F1/F10-top/bottom   Up/Down-move cursor"
  201. PRINT "RETURN    -extract            F5/F6 -scroll u/d   Esc   -exit"
  202. 3020 a$=INKEY$ : IF a$="" THEN 3020
  203. IF a$=CHR$(30) THEN diedaar
  204. IF a$=CHR$(31) THEN 3050
  205. IF a$=CHR$(28) AND x > 3 THEN x=x-1 : GOTO 3010
  206. IF a$=CHR$(28) THEN x=20 : GOTO 3010
  207. IF a$=CHR$(29) AND x < 20 THEN x=x+1 : GOTO 3010
  208. IF a$=CHR$(29) THEN x=3 : GOTO 3010
  209. IF a$=CHR$(27) THEN xt=1 : RETURN
  210. IF a$=CHR$(129) THEN i=0 : GOTO diedaar
  211. IF a$=CHR$(138) THEN bottom
  212. IF a$=CHR$(133) THEN mineenregel
  213. IF a$=CHR$(134) THEN eenregel
  214. IF a$=CHR$(13) THEN 3030
  215. GOTO 3020
  216. mineenregel:
  217. i=i-19 : IF i < 0 THEN i=0
  218. GOTO diedaar
  219. eenregel:
  220. i=i-17 : IF i < 0 THEN i=0
  221. GOTO diedaar
  222. bottom:
  223. i=nu-18 : IF i < 0 THEN i=0
  224. diedaar:
  225. GOSUB header : y=0 : RETURN
  226. 3030 i=i-18 : IF i < 0 THEN i=0
  227. j=i : i=i+x-2 : GOSUB header
  228. GOSUB wrcom : GOSUB retern : i=j : GOTO diedaar
  229. 3050 i=i-18 : i=i-18 : IF i < 0 THEN i=0
  230. GOTO diedaar
  231.  
  232. 1000 GOSUB header : a$="INPUT" : GOSUB wrsn:PRINT : GOSUB getitem
  233. IF xt=1 THEN RETURN
  234. IF xt=2 THEN 1000
  235. GOTO naitemget
  236. getitem:
  237. xt=0 : PRINT :PRINT "(C)ompact disc, (T)ape or (R)ecord  [C/T/R] ? ";
  238. 1010 a$=INKEY$ : IF a$="" THEN 1010
  239. IF a$=CHR$(27) THEN xt=1 : RETURN
  240. a$=UCASE$(a$)
  241. IF a$="C" THEN b$="CD  " : GOTO 1020
  242. IF a$="T" THEN b$="TAPE" : GOTO 1020
  243. IF a$="R" THEN b$="RECD" : GOTO 1020
  244. GOTO 1010
  245. 1020 PRINT b$ : b$=b$+"  -  Dated: "
  246. PRINT "Enter date of purchase/copy (dd.mm.yy):";
  247. GOSUB getanumber : LOCATE y,x : PRINT a$; : c$=a$ 
  248. GOSUB getanumber : LOCATE y,x : PRINT a$; : c$=c$+a$ : b=VAL(c$)
  249. IF b < 1 OR b > 31 THEN xt=2 : RETURN
  250. PRINT "."; : b$=b$+c$+"." 
  251. GOSUB getanumber : LOCATE y,x : PRINT a$; : c$=a$ 
  252. GOSUB getanumber : LOCATE y,x : PRINT a$; : c$=c$+a$ : b=VAL(c$)
  253. IF b < 1 OR b > 12 THEN xt=2 : RETURN
  254. PRINT "."; : b$=b$+c$+"." 
  255. GOSUB getanumber : LOCATE y,x : PRINT a$; : c$=a$ 
  256. GOSUB getanumber : LOCATE y,x : PRINT a$; : c$=c$+a$ : b=VAL(c$)
  257. b$=b$+c$+"  -  "
  258. PRINT : PRINT "Enter specifications :";:c$=b$
  259. GOSUB gettext : c$=c$+b$
  260. hedinput:
  261. d$="*"
  262. PRINT : PRINT "Enter header below:"
  263. PRINT ">"; :GOSUB gettext
  264. d$=d$+b$ :FOR i = 1 TO nu : IF header$(i)=d$ THEN alreadyex
  265. NEXT : GOTO continue
  266. alreadyex:
  267. PRINT :PRINT "Sorry already exists." : GOTO hedinput
  268. continue:
  269. nu=nu+1 : header$(nu)=d$ : index$(nu,1)=c$:link(nu)=nu
  270. FOR i = 2 TO 31 : index$(nu,i)="":NEXT
  271. RETURN
  272.  
  273. naitemget:
  274. PRINT :PRINT  : i=nu : GOSUB wrhdp
  275. PRINT : PRINT "Okay ? (y/n) : ";
  276. 1405 a$=INKEY$ : IF a$="y" OR a$="Y" THEN 1410
  277.      IF a$=CHR$(27) THEN RETURN
  278.      IF a$ <> "n" AND a$ <> "N" THEN 1405
  279.      nu=nu-1 : GOTO 1000
  280. 1410 PRINT "yes" : GOSUB sorteren :GOTO nasorteren
  281. sorteren:
  282. PRINT :a$="Sorting... " : GOSUB wrsn :PRINT
  283. FOR i = 1 TO nu
  284. IF header$(nu) > header$(i) THEN sort
  285. SWAP header$(i),header$(nu)
  286. SWAP link(i),link(nu)
  287. sort:
  288. NEXT i : RETURN
  289. nasorteren:
  290. FOR i = 1 TO nu : IF header$(i)=d$ THEN editindex
  291. NEXT : PRINT "1:Error (before editindex lab)" : GOTO 8088
  292.  
  293. editindex:
  294. GOSUB header : LOCATE 1,20 : PRINT "EDIT :";header$(i)
  295. l=link(i) : a=l : x=2 : t=1 : xy=1
  296. FOR i = 1 TO 30 : a$=index$(l,i+1) : IF a$="" THEN a$=" "
  297. a$=a$+" " : buffer$(i)=a$ :NEXT
  298. LOCATE 3,1 : FOR i = 1 TO 76 : PRINT "-"; : NEXT
  299. LOCATE 20,1 : FOR i = 1 TO 76 : PRINT "-";: NEXT
  300. PRINT
  301. PRINT "`   : insert a subheader    Esc : to exit      TAB : 6 right"
  302. PRINT "~   : remove a subheader    F1  : top          F10 : bottom"
  303. ed2:
  304. COLOR 2,0
  305. FOR y=1 TO 16 :LOCATE y+3,1 : PRINT SPACE$(75)
  306. LOCATE y+3,1 : PRINT  buffer$(t+y-1)  : NEXT
  307. ed3:
  308. IF x > LEN(buffer$(xy+t-1)) THEN x=LEN(buffer$(xy+t-1))
  309. LOCATE xy+3,1 : COLOR 2,0 : PRINT LEFT$(buffer$(xy+t-1)+SPACE$(73),75)
  310. LOCATE xy+3,x : COLOR 0,3 : PRINT MID$(buffer$(xy+t-1),x,1)
  311. COLOR 2,0
  312. ed:
  313. a$=INKEY$ : IF a$="" THEN ed
  314. IF a$=CHR$(27) THEN eindeedit
  315. IF a$=CHR$(28) AND xy > 1 THEN keyup
  316. IF a$=CHR$(28) AND t > 1 THEN xy=14 : t=1 : GOTO ed2
  317. IF a$=CHR$(29) AND xy < 16 THEN keydown
  318. IF a$=CHR$(29) AND t < 15 THEN t=15 : xy=3 : GOTO ed2
  319. IF a$=CHR$(31) AND x > 2 THEN x=x-1 : GOTO ed3
  320. IF a$=CHR$(30) THEN keyright
  321. IF a$="`" THEN buffer$(xy+t-1)="-"+RIGHT$(buffer$(xy+t-1),LEN(buffer$(xy+t-1))-1):GOTO ed3
  322. IF a$="~" THEN buffer$(t+xy-1)=" "+RIGHT$(buffer$(xy+t-1),LEN(buffer$(xy+t-1))-1):GOTO ed3
  323. IF a$=CHR$(127) THEN delly
  324. IF a$=CHR$(8) AND x > 2 THEN buffer$(xy+t-1)=LEFT$(buffer$(xy+t-1),x-2)+RIGHT$(buffer$(t+xy-1),LEN(buffer$(xy+t-1))-x+1):x=x-1 : GOTO ed3
  325. IF a$=CHR$(8) AND (xy > 1 OR t > 1) THEN delback
  326. IF a$=CHR$(9) THEN tabbie
  327. IF a$=CHR$(129) THEN t=1 :x=2:xy=1: GOTO ed2
  328. IF a$=CHR$(138) THEN t=15:x=2:xy=16: GOTO ed2
  329. IF a$=CHR$(13) THEN retournados
  330. IF ASC(a$)>31 AND ASC(a$)<127 THEN justanalphanum
  331. GOTO ed
  332. delly:
  333. IF LEN(buffer$(xy+t-1)) < 2 THEN ed2
  334. buffer$(xy+t-1)=LEFT$(buffer$(xy+t-1),x-1)+MID$(buffer$(xy+t-1),x+1,LEN(buffer$(xy+t-1))-x)
  335. IF RIGHT$(buffer$(xy+t-1),1) <> " " THEN buffer$(xy+t-1)=buffer$(xy+t-1)+" "
  336. IF buffer$(xy+t-1)=" " THEN buffer$(xy+t-1)="  "
  337. GOTO ed3
  338. keyup:
  339. LOCATE xy+3,1 : COLOR 2,0 : PRINT buffer$(xy+t-1):xy=xy-1:GOTO ed3
  340. keydown:
  341. LOCATE xy+3,1 : COLOR 2,0 : PRINT buffer$(xy+t-1):xy=xy+1:GOTO ed3
  342. keyright:
  343. x=x+1 : IF x > 75 THEN x=75
  344. GOTO ed3
  345. justanalphanum:
  346. x$=RIGHT$(buffer$(xy+t-1),LEN(buffer$(xy+t-1))+1-x)
  347. buffer$(xy+t-1)=LEFT$(buffer$(t+xy-1),x-1)+a$
  348. buffer$(xy+t-1)=buffer$(t+xy-1)+x$
  349. x=x+1
  350. GOTO ed3                      
  351. tabbie:
  352. x=x+6 : IF x > 75 THEN x=75 
  353. GOTO ed3
  354. retournados:
  355. IF t > 1 AND xy > 15 THEN ed3
  356. FOR i = 30 TO t+xy+1 STEP -1
  357. buffer$(i)=buffer$(i-1)
  358. NEXT
  359. buffer$(xy+t)="  "
  360. xy=xy+1:IF xy > 16 THEN xy=3 : t=15
  361. GOTO ed2
  362. delback:
  363. IF t=1 AND xy=1 THEN ed2
  364. FOR i = t+xy-2 TO 29
  365. buffer$(i)=buffer$(i+1)
  366. NEXT
  367. buffer$(30)="  "
  368. xy=xy-1 : IF xy < 1 THEN t=1 : xy=14
  369. x=2 : GOTO ed2
  370. eindeedit:
  371. GOSUB header
  372. a$="Sorting your index and removing blancs..":GOSUB wrsn
  373. x=2 : FOR i = 1 TO 30 : k$=buffer$(i) : k$=LEFT$(k$,75)
  374. jee3:
  375. IF RIGHT$(k$,1)=" " THEN k$=LEFT$(k$,LEN(k$)-1) : GOTO jee3
  376. IF k$ > "" THEN index$(a,x)=k$ : x=x+1 
  377. NEXT i : FOR i = x+1 TO 31 : index$(a,i)="" : NEXT
  378. FOR i = 2 TO 31 : IF LEFT$(index$(a,i),1)="-" THEN GOSUB doit
  379. NEXT i
  380. FOR i = 1 TO nu : IF link(i)=a THEN found
  381. NEXT : PRINT "2:Error (Line in jee3 lab)":GOTO 8088
  382. found:
  383. GOSUB header: GOSUB wrcom
  384. GOSUB retern
  385. RETURN
  386. doit:
  387. FOR j = i+1 TO 31 : IF LEFT$(index$(a,j),1)="-" THEN doit2
  388. IF index$(a,j)="" THEN doit2
  389. NEXT j 
  390. doit2:
  391. j=j-1
  392. FOR l = 1 TO (j-i)
  393. FOR b = (i+1) TO (j-1)
  394. IF index$(a,b) < index$(a,b+1) THEN doit3
  395. SWAP index$(a,b),index$(a,b+1)
  396. doit3:
  397. NEXT b :NEXT l
  398. RETURN
  399.  
  400. einde:
  401. PALETTE 1,0,0,1
  402. WINDOW CLOSE 2
  403. END
  404.  
  405. svdata:
  406. PALETTE 3,1,1,1 : COLOR 2,0
  407. t=INT(nu/20)+1 : b=t : CLS : PRINT : PRINT "Writing datafile..."
  408. LOCATE 10,1 : PRINT "> . . . . . . . . . . . . . . . . . . . . <   transfer level"
  409. LOCATE 10,3 : COLOR 3,0
  410. OPEN "TALED" FOR OUTPUT AS #2
  411. PRINT #2,nu
  412. FOR i = 1 TO nu
  413. IF i=t THEN t=t+b : PRINT ". ";
  414. PRINT #2,header$(i)
  415. PRINT #2,link(i)
  416. FOR j = 1 TO 31 : IF index$(i,j)="" THEN PRINT #2,"@" : GOTO svd
  417. PRINT #2,index$(i,j)
  418. NEXT j
  419. svd:
  420. NEXT i
  421. CLOSE #2
  422. PALETTE 3,.3,.3,1
  423. RETURN
  424.  
  425. 2000 GOSUB header : PRINT "Delete"
  426. GOSUB searchforheader : GOTO 2005
  427. searchforheader:
  428. k=1 : PRINT : PRINT "Enter header :";:GOSUB gettext
  429. d$="":FOR i = 1 TO LEN(b$) : d$=d$+UCASE$(MID$(b$,i,1)) :NEXT
  430. searchinjump:
  431. xt=0 : FOR i = k TO nu : c$=header$(i) : b$="":l=LEN(d$)+1
  432. IF l > LEN(c$) THEN l=LEN(c$)
  433. FOR j = 2 TO l
  434. b$=b$+UCASE$(MID$(c$,j,1)) : NEXT
  435. IF b$=d$ THEN dalreadyex
  436. NEXT :PRINT :PRINT "Doesn't exist." : GOSUB retern : xt=1 : RETURN
  437. dalreadyex:
  438. PRINT
  439. PRINT "Type   : ";LEFT$(index$(link(i),1),4)
  440. PRINT "Header : ";header$(i) : k=i+1 : RETURN
  441.  
  442. 2005 IF xt=1 THEN RETURN
  443. PRINT :a$="Delete or continue search ? (d/c) : " : GOSUB wrsn
  444. COLOR 3,0 : PRINT "_" : COLOR 2,0 :i=kk
  445. 2010 a$=INKEY$ : IF a$="c" THEN GOSUB searchinjump : GOTO 2005
  446. IF a$=CHR$(27) THEN RETURN
  447. IF a$<>"d" THEN 2010
  448. a$="Deleting..." : GOSUB wrsn : PRINT :i=k-1 : l=link(i)
  449. FOR j = i TO nu-1 : header$(j)=header$(j+1)
  450. link(j)=link(j+1) : NEXT
  451. IF l=nu THEN nu=nu-1 : RETURN
  452. FOR j = 1 TO 31 : index$(l,j)=index$(nu,j) : NEXT : nu=nu-1
  453. FOR j = 1 TO nu : IF link(j)=nu+1 THEN link(j)=l : GOTO 2050
  454. NEXT
  455. 2050 RETURN
  456.  
  457. 4000 GOSUB header : PRINT "PRINT"
  458. b$="" : FOR i = 1 TO 250 : b$=b$+"0" : NEXT
  459. t=1 : y=0
  460. 4010 GOSUB header : PRINT "PRINT"
  461. IF t < 1 THEN t=1
  462. b=t+10 : IF b > nu THEN b=nu : t=b-10 : IF t < 1 THEN t=1
  463. FOR i = t TO b : COLOR 2,0 : LOCATE i-t+6,2
  464. IF MID$(b$,i,1)="1" THEN COLOR 0,2
  465. PRINT header$(i) : NEXT : COLOR 2,0
  466. FOR b = i-t+6 TO 18 : LOCATE b,1 : PRINT SPACE$(75) : NEXT
  467. 4015 IF y < 0 THEN y=10
  468. IF y > 10 THEN y=0
  469. LOCATE 5+y,1 : PRINT " " : LOCATE 7+y,1 : PRINT " "
  470. LOCATE 6,1 : PRINT " " : LOCATE 16,1 : PRINT " "
  471. LOCATE 6+y,1 : COLOR 0,3 : PRINT " " : COLOR 2,0
  472. LOCATE 19,1
  473. PRINT "Use : F1-top / F10-bottom / Up / Down / Left / Right"
  474. PRINT "Functions:  F - fill all           C - clear all"
  475. PRINT "            T - fill all tapes     D - fill all discs"
  476. PRINT "            R - fill all records   P - print"
  477. PRINT "        SPACE - (de)select       Esc - quit"
  478. PRINT 
  479. PRINT " Colors : "; : COLOR 0,2 : PRINT "selected"; : COLOR 2,0
  480. PRINT " not selected     ( to print )"
  481. 4020 a$=INKEY$ : IF a$="" THEN 4020
  482. IF a$=CHR$(27) THEN RETURN
  483. IF a$=CHR$(129) THEN t=1 : GOTO 4010
  484. IF a$=CHR$(138) THEN t=nu-10 : GOTO 4010
  485. IF a$=CHR$(28) THEN y=y-1 : GOTO 4015
  486. IF a$=CHR$(29) THEN y=y+1 : GOTO 4015
  487. IF a$=CHR$(31) THEN t=t-11 : GOTO 4010
  488. IF a$=CHR$(30) THEN t=t+11 : GOTO 4010
  489. IF a$="f" THEN fillall
  490. IF a$="c" THEN clearall
  491. IF a$="t" THEN filltapes
  492. IF a$="d" THEN filldiscs
  493. IF a$="r" THEN fillrecords
  494. IF a$="p" THEN prit
  495. IF a$=" " THEN desel
  496. GOTO 4020
  497. fillall:
  498. GOSUB header
  499. b$="" : FOR i = 1 TO nu : b$=b$+"1" : NEXT
  500. FOR i = nu+1 TO 250 : b$=b$+"0" : NEXT : GOTO 4010
  501. clearall:
  502. GOSUB header
  503. b$="" : FOR i = 1 TO 250 : b$=b$+"0" : NEXT : GOTO 4010
  504. filltapes:
  505. GOSUB header
  506. FOR i = 1 TO nu
  507. l=link(i) : a$=LEFT$(index$(l,1),1) : IF a$="T" THEN GOSUB sel
  508. NEXT : GOTO 4010
  509. sel:
  510. b$=LEFT$(b$,i-1)+"1"+RIGHT$(b$,250-i) : RETURN
  511. dsel:
  512. b$=LEFT$(b$,i-1)+"0"+RIGHT$(b$,250-i) : RETURN
  513. filldiscs:
  514. GOSUB header
  515. FOR i = 1 TO nu
  516. l=link(i) : a$=LEFT$(index$(l,1),1) : IF a$="C" THEN GOSUB sel
  517. NEXT : GOTO 4010
  518. fillrecords:
  519. GOSUB header
  520. FOR i = 1 TO nu
  521. l=link(i) : a$=LEFT$(index$(l,1),1) : IF a$="R" THEN GOSUB sel
  522. NEXT : GOTO 4010
  523. desel:
  524. i=t+y
  525. IF MID$(b$,i,1)="1" THEN GOSUB dsel : GOTO 4010
  526. GOSUB sel : GOTO 4010
  527. prit:
  528. GOSUB header : PRINT "PRINT" : PRINT
  529. PRINT "You have now chosen : ";
  530. y=0 : FOR i = 1 TO 250 : IF MID$(b$,i,1)="1" THEN y=y+1
  531. NEXT : PRINT y;" headers to be printed." : IF y > 0 THEN 4099
  532. PRINT : PRINT "Press Return..."
  533. WHILE INKEY$="" : WEND : RETURN
  534. 4099 PRINT "Please choose a format : (1) Headers"
  535. PRINT "                         (2) Headers + Specifications"
  536. PRINT "                         (3) Headers + Specifications + Index"
  537. PRINT "Choose : ";
  538. 4110 a$=INKEY$ : l=VAL(a$) : IF l < 1 OR l > 3 THEN 4110
  539. PRINT l
  540. PRINT : PRINT "Opening printer device...insert a sheet   <RETURN>"
  541. 4111 a$=INKEY$ : IF a$=CHR$(27) THEN RETURN
  542. IF a$ <> CHR$(13) THEN 4111
  543. OPEN "lpt1:" FOR OUTPUT AS #2
  544. PRINT #2," " : GOSUB header : PRINT "PRINT" : PRINT
  545. PRINT "Ok." : t=0 : b=48 : GOTO 4120
  546. test:
  547. b=b+1 : IF b < 49 THEN RETURN
  548. t=t+1
  549. PRINT "Please insert sheet : ";t;"   <RETURN>"
  550. WHILE INKEY$<>CHR$(13) : WEND : b=0 : PRINT "printing..."
  551. RETURN
  552. 4120 FOR i = 1 TO nu : IF MID$(b$,i,1)="1" THEN GOSUB prithisone
  553. NEXT : CLOSE #2 : PRINT "Ready.   <RETURN>"
  554. GOSUB retern : RETURN
  555. prithisone:
  556. GOSUB test
  557. PRINT #2,header$(i)
  558. IF l=1 THEN eindethisone
  559. GOSUB test
  560. PRINT #2,index$(link(i),1)
  561. IF l=2 THEN eindethisone
  562. FOR j = 2 TO 31
  563. a$=index$(link(i),j)
  564. IF a$="" THEN eveneindethisone
  565. GOSUB test
  566. PRINT #2,a$
  567. NEXT
  568. eveneindethisone:
  569. PRINT #2," "
  570. eindethisone:
  571. RETURN
  572.  
  573. 6000 GOSUB header : PRINT "Edit"
  574. GOSUB searchforheader
  575. 6005 IF xt=1 THEN RETURN
  576. PRINT :a$="Edit or continue search ? (e/c) : " : GOSUB wrsn : COLOR 3,0
  577. PRINT "_" : COLOR 2,0  :i=k-1
  578. 6020 a$=INKEY$ : IF a$="c" THEN GOSUB searchinjump : GOTO 6005
  579. IF a$=CHR$(27) THEN RETURN
  580. IF a$<>"e" THEN 6020
  581. GOTO editindex
  582.  
  583. 7000 GOSUB header
  584. OPEN "tale.help" FOR INPUT AS #2
  585. 7005 FOR i = 1 TO 20
  586. LINE INPUT #2,buffer$(i)
  587. IF buffer$(i)="*eindedatafile*" THEN CLOSE #2 : RETURN
  588. NEXT
  589. GOSUB header
  590. FOR i = 1 TO 20 : PRINT buffer$(i) : NEXT
  591. PRINT : PRINT
  592. PRINT "Press ESC or RETURN ...";
  593. 7010 a$=INKEY$ : IF a$="" THEN 7010
  594. IF a$=CHR$(27) THEN CLOSE #2 : RETURN
  595. IF a$=CHR$(13) THEN 7020
  596. GOTO 7010
  597. 7020 LOCATE CSRLIN,1 : PRINT "Reading....            " : GOTO 7005
  598.  
  599. 8000 GOSUB header : PRINT "DELETE ALL"
  600. GOSUB getcode : IF xt=1 THEN RETURN
  601. PRINT : a$="Correct accesscode...all deleted." : GOSUB wrsn
  602. nu=0 : GOSUB retern : RETURN
  603.  
  604. 8088 GOTO 8088
  605.  
  606. 9000 REM ** check for errors in datafile
  607. GOSUB header : kk=0
  608. PRINT "Checking for errors in arraydata.."
  609. PRINT "Still to go :"; : y=CSRLIN : x=POS(0)
  610. FOR i = 1 TO nu
  611. LOCATE y,x : PRINT nu-i
  612. FOR j=1 TO 31
  613. a$=index$(link(i),j) : FOR k = 1 TO LEN(a$)
  614. b$=MID$(a$,k,1) : IF b$ > CHR$(31) AND b$ < CHR$(127) THEN 9010
  615. kk=kk+1 : LOCATE y+kk,1 : PRINT "Error in : ";header$(i) : GOTO 9020
  616. 9010 NEXT k
  617.      NEXT j
  618. 9020 NEXT i : LOCATE y-1,1
  619. IF kk=0 THEN PRINT "No errors.                              " : GOTO 9030
  620. PRINT kk;" errors, fix with edit function.             "
  621. 9030 GOSUB retern : RETURN
  622.  
  623. 9999 REM ; Special Menu ;
  624. GOSUB header
  625. PRINT
  626. PRINT "Special menu --"
  627. PRINT
  628. PRINT "  1. Memory information"
  629. PRINT "  2. See help file"
  630. PRINT "  3. Check arraydata for errors"
  631. PRINT "  4. Search for artist/group"
  632. PRINT "  5. Search for special song"
  633. PRINT "  6. Cover constructor"
  634. PRINT "  7. Datafile operator"
  635. PRINT "  8. Credits"
  636. PRINT "  9. Main menu"
  637. PRINT
  638. PRINT "Choice : "; : GOSUB getanumber
  639. b=VAL(a$) : IF b < 1 OR b > 9 THEN 9999
  640. IF b=9 THEN RETURN
  641. ON b GOSUB sm1,7000,9000,sm4,sm5,sm6,sm7,credits
  642. GOTO 9999
  643.  
  644. sm1:
  645. GOSUB header : PRINT "Memory information" :PRINT
  646. PRINT "Total number of items   : ";nu
  647. PRINT "  .. please wait .. "; : LOCATE CSRLIN,1
  648. l=0 : FOR i = 1 TO nu : l=l+LEN(header$(i))
  649. FOR j = 1 TO 31 : l=l+LEN(index$(i,j)) : NEXT : NEXT
  650. PRINT "Total arraydata size    : ";l;"bytes"
  651. PRINT "Average size per item   : ";INT(l/nu);"bytes"
  652. PRINT "Total remaining free mem: ";FRE(0);"bytes"
  653. PRINT "Memory for about        : ";INT(FRE(0)/(l/nu));"new items"
  654. GOSUB retern : RETURN
  655.  
  656. sm2:
  657. GOSUB header : PRINT "Change header and specs" : PRINT
  658. GOSUB searchforheader
  659. m05:
  660. IF xt=1 THEN RETURN
  661. PRINT :a$="Rename or continue search ? (r/c) : " : GOSUB wrsn : COLOR 3,0
  662. PRINT "_" : COLOR 2,0  :i=k-1
  663. m20:
  664. a$=INKEY$ : IF a$="c" THEN GOSUB searchinjump : GOTO m05
  665. IF a$=CHR$(27) THEN RETURN
  666. IF a$<>"r" THEN m20
  667. nu=nu+1 : header$(nu)=header$(i) : link(nu)=link(i)
  668. FOR j = i TO nu-1 : header$(j)=header$(j+1) : link(j)=link(j+1)
  669. NEXT : nu=nu-1 :
  670. m30:
  671. GOSUB header : PRINT "Change header and specs"
  672. PRINT "Changing : ";header$(nu)
  673. GOSUB getitem
  674. IF xt=1 OR xt=2 THEN m30
  675. nu=nu-1 : header$(nu)=header$(nu+1) 
  676. index$(link(nu),1)=index$(nu+1,1) : GOSUB sorteren : PRINT
  677. PRINT "Header and specifications changed and sorted."
  678. GOSUB retern : RETURN
  679.  
  680. sm4:
  681. GOSUB header : PRINT "Search for group/artist" : PRINT
  682. PRINT : PRINT "Enter (part of) searchkey :"; : GOSUB gettext
  683. PRINT : PRINT "Search terminated."
  684. PRINT "Not found." : GOSUB retern
  685. RETURN
  686.  
  687. sm5:
  688. GOSUB header : PRINT "Search for a song" : PRINT
  689. PRINT : PRINT "Enter (part of) songname :";:GOSUB gettext
  690. d$="":FOR i = 1 TO LEN(b$) : d$=d$+UCASE$(MID$(b$,i,1)) :NEXT
  691. d$=" "+d$ : k=1 : b=2
  692. sinjump:
  693. GOSUB header : PRINT "Search for a song" : PRINT
  694. PRINT "Searching for   :";d$
  695. PRINT "Remaining items :"; : y=CSRLIN : x=POS(0)
  696. FOR i = k TO nu : LOCATE y,x : PRINT nu-i
  697. FOR kk = b TO 31
  698. c$=index$(link(i),kk) : b$="":l=LEN(d$)
  699. IF l > LEN(c$) THEN l=LEN(c$)
  700. FOR j = 1 TO l
  701. b$=b$+UCASE$(MID$(c$,j,1)) : NEXT
  702. IF b$=d$ THEN gotasong
  703. NEXT : b=2 : NEXT
  704. PRINT :PRINT "No (more) matches." : GOSUB retern :RETURN
  705. gotasong:
  706. k=i : b=kk+1
  707. FOR i = kk TO 2 STEP -1
  708. b$=index$(link(k),i)
  709. IF LEFT$(b$,1)="-" THEN okayyoo
  710. NEXT
  711. okayyoo:
  712. b$=RIGHT$(b$,LEN(b$)-1)
  713. GOSUB header : PRINT "Search for a song" : PRINT
  714. PRINT "Search pattern         :";d$
  715. PRINT "Found                  :";index$(link(k),kk)
  716. PRINT "Corresponding subheader: ";b$
  717. PRINT
  718. PRINT "On:"
  719. PRINT header$(k)
  720. PRINT index$(link(k),1)
  721. PRINT
  722. PRINT
  723. PRINT :a$="Print, escape or continue search ? (p/esc/c) : " : GOSUB wrsn
  724. COLOR 3,0 : PRINT "_" : COLOR 2,0
  725. sm5a:
  726. a$=INKEY$ : IF a$="c" THEN sinjump 
  727. IF a$=CHR$(27) THEN RETURN
  728. IF a$<>"p" THEN sm5a
  729. PRINT : PRINT "Printing..."
  730. OPEN "lpt1:" FOR OUTPUT AS #1
  731. a$=LEFT$(index$(link(k),kk)+SPACE$(50),50)+"("+LEFT$(header$(k),25)+")"
  732. PRINT #1,a$
  733. CLOSE #1
  734. RETURN
  735.  
  736. sm6:
  737. a$="" : FOR j = 1 TO 59 : a$=a$+"·" : NEXT
  738. FOR i = 3 TO 13 : buffer$(i)=a$ : NEXT
  739. buffer$(2)=" " : buffer$(14)=" " 
  740. a$=LEFT$(a$,39)
  741. buffer$(15)=a$ : buffer$(16)=a$ : buffer$(1)=a$
  742. continuecoveredit:
  743. GOSUB header : PRINT "cover constructor" : PRINT
  744. 9869 x=1 : y=1 : LOCATE 22,1
  745. PRINT "TAB-3 forward   F1-Copy from above  Esc-Ready   F10-Save"
  746. PRINT "`  -3 back      F2-Copy from below              F6 -Load"
  747. LOCATE 5,1 : COLOR 2,0
  748. FOR i = 1 TO 16 : PRINT buffer$(i) : NEXT 
  749. 9870 GOSUB 9879
  750. COLOR 2,3 : LOCATE 4+y,x : PRINT MID$(buffer$(y),x,1) : COLOR 2,0
  751.  
  752. 9871 a$=INKEY$ : IF a$="" THEN 9871
  753. IF a$=CHR$(27) THEN weitergehen
  754. IF a$=CHR$(28) AND y > 1 THEN 9872
  755. IF a$=CHR$(29) AND y < 16 THEN 9873
  756. IF a$=CHR$(31) AND x > 1 THEN x=x-1 : GOTO 9870
  757. IF a$=CHR$(30) THEN 9874
  758. IF a$=CHR$(127) THEN 9876
  759. IF a$=CHR$(138) THEN savecover
  760. IF a$=CHR$(134) THEN loadcover
  761. IF a$=CHR$(129) AND y > 3 AND y < 14 THEN copyboven
  762. IF a$=CHR$(130) AND y > 2 AND y < 13 THEN copybeneden
  763. IF a$=CHR$(8) AND x > 1 THEN buffer$(y)=LEFT$(buffer$(y),x-2)+RIGHT$(buffer$(y),LEN(buffer$(y))-x+1)+"·":x=x-1 : GOTO 9870
  764. IF a$=CHR$(9) THEN 9877
  765. IF a$="`" THEN 9891
  766. IF a$=CHR$(13) AND y < 16 THEN x=1: GOTO 9873
  767. IF ASC(a$)>31 AND ASC(a$)<127 THEN 9878
  768. GOTO 9871
  769.  
  770. copyboven:
  771. a$=MID$(buffer$(y-1),x,1) : GOTO 9878
  772. copybeneden:
  773. a$=MID$(buffer$(y+1),x,1) : GOTO 9878
  774. 9876 buffer$(y)=LEFT$(buffer$(y),x-1)+MID$(buffer$(y),x+1,LEN(buffer$(y))-x)+"·"
  775.      GOTO 9870
  776. 9878 IF a$=" " THEN a$="·"
  777.      x$=RIGHT$(buffer$(y),LEN(buffer$(y))+1-x)
  778.      IF x$="" THEN buffer$(y)=LEFT$(buffer$(y),LEN(buffer$(y))-1)+a$ : GOTO 9870
  779.      buffer$(y)=LEFT$(buffer$(y),x-1)+a$
  780.      buffer$(y)=buffer$(y)+LEFT$(x$,LEN(x$)-1)
  781. 9890 x=x+1 : GOTO 9870
  782. 9877 x=x+3 : GOTO 9874
  783. 9891 x=x-3 : IF x < 1 THEN x=1
  784.      GOTO 9870
  785. 9872 GOSUB 9879 : y=y-1 : IF y=2 OR y=14 THEN y=y-1
  786.      IF y=1 OR y=15 OR y=16 THEN GOSUB 9875
  787.      GOTO 9870      
  788. 9873 GOSUB 9879 : y=y+1 : IF y=2 OR y=14 THEN y=y+1
  789.      IF y=1 OR y=15 OR y=16 THEN GOSUB 9875
  790.      GOTO 9870
  791. 9874 x=x+1 : IF x > 59 THEN x=59
  792.      IF y=1 OR y=15 OR y=16 THEN GOSUB 9875
  793.      GOTO 9870
  794. 9875 IF x > 39 THEN x=39 
  795.      RETURN
  796. 9879 LOCATE 4+y,1 : PRINT buffer$(y) : RETURN                              
  797. savecover:
  798. OPEN "tale.cover" FOR OUTPUT AS #2
  799. FOR i = 1 TO 16 : PRINT #2,buffer$(i) : NEXT : CLOSE #2
  800. GOTO 9870
  801. loadcover:
  802. OPEN "tale.cover" FOR INPUT AS #2
  803. FOR i = 1 TO 16 : LINE INPUT #2,buffer$(i) : NEXT : CLOSE #2
  804. GOTO 9869
  805.  
  806. weitergehen:
  807. GOSUB header : PRINT "Cover constructor" : PRINT
  808. FOR i = 1 TO 16 : PRINT buffer$(i) : NEXT : PRINT
  809. PRINT "(P)rint, (C)ontinue, or (Esc)ape  ?? "
  810. wg:
  811. a$=INKEY$ : IF a$=CHR$(27) THEN RETURN
  812. IF a$="c" THEN continuecoveredit
  813. IF a$ <> "p" THEN wg
  814. LOCATE 22,1
  815. PRINT "Removing dots....                          ";
  816. FOR i = 1 TO 16 : a$=buffer$(i) : b$=""
  817. FOR j = 1 TO LEN(a$) : c$=MID$(a$,j,1) : IF c$="·" THEN c$=" "
  818. b$=b$+c$ : NEXT : buffer$(i)=b$
  819. NEXT
  820. LOCATE csrlin,1 : PRINT "Printing...        "
  821. OPEN "lpt1:" FOR OUTPUT AS #2
  822. FOR i = 1 TO 3
  823. PRINT #2," "
  824. NEXT
  825. PRINT #2,CHR$(18);buffer$(1)
  826. PRINT #2,CHR$(15);
  827. FOR i = 2 TO 14
  828. PRINT #2,buffer$(i)
  829. NEXT
  830. PRINT #2,CHR$(18);
  831. PRINT #2,buffer$(15)
  832. PRINT #2,buffer$(16)
  833. CLOSE #2
  834. GOSUB retern : RETURN
  835.  
  836. sm7:
  837. GOSUB datopheader
  838. OPEN "tale.datop" FOR INPUT AS #2
  839. FOR i = 1 TO 5 : LINE INPUT #2,buffer$(i) : NEXT : CLOSE #2
  840. PRINT "Current Datop: ";buffer$(1)
  841. PRINT "Address      : ";buffer$(2)
  842. FOR i = 3 TO 5
  843. PRINT "               ";buffer$(i) : NEXT
  844. PRINT
  845. PRINT "1. Enter New Datop"
  846. PRINT "2. Enter New Address"
  847. PRINT "3. Exit"
  848. PRINT
  849. PRINT "Make a choice please : "; : GOSUB getanumber
  850. b=VAL(a$) : IF b < 1 OR b > 3 THEN sm7
  851. IF b=3 THEN RETURN
  852. IF b=1 THEN newdatop
  853.  
  854. addressdatop:
  855. GOSUB datopheader : PRINT "You have 4 lines for the address:"
  856. FOR i = 2 TO 5 : PRINT ">";
  857. GOSUB gettext : buffer$(i)=b$ : NEXT
  858. PRINT
  859. PRINT "Saving..."
  860. OPEN "tale.datop" FOR OUTPUT AS #2
  861. FOR i = 1 TO 5
  862. PRINT #2,buffer$(i)
  863. NEXT : CLOSE #2 : GOTO sm7
  864.  
  865. newdatop:
  866. GOSUB datopheader : PRINT "Enter your name:" : PRINT ">";
  867. GOSUB gettext : buffer$(1)=b$ : PRINT : GOTO addressdatop
  868. datopheader:
  869. GOSUB header : PRINT "Datafile operator" : PRINT : RETURN
  870.  
  871. credits:
  872. GOSUB header : PRINT : OPEN "tale.credits" FOR INPUT AS #2
  873. FOR kk = 1 TO 20 : LINE INPUT #2,a$ : GOSUB wrsn : PRINT
  874. NEXT : CLOSE #2
  875. GOSUB retern : RETURN
  876.